home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Basic / Visual Basic.60 / COMMON / TOOLS / VB / UNSUPPRT / SHELLLNK / TESTSLNK / TESTSLNK.FRM (.txt) next >
Encoding:
Visual Basic Form  |  1997-01-16  |  13.8 KB  |  353 lines
  1. VERSION 5.00
  2. Begin VB.Form frmTestSLnk 
  3.    BorderStyle     =   4  'Fixed ToolWindow
  4.    Caption         =   "Tests the IShellLink Typelib Interface."
  5.    ClientHeight    =   3780
  6.    ClientLeft      =   420
  7.    ClientTop       =   720
  8.    ClientWidth     =   9195
  9.    LinkTopic       =   "Form1"
  10.    MaxButton       =   0   'False
  11.    MinButton       =   0   'False
  12.    ScaleHeight     =   3780
  13.    ScaleWidth      =   9195
  14.    ShowInTaskbar   =   0   'False
  15.    Begin VB.TextBox txtProgramGroup 
  16.       Height          =   285
  17.       Left            =   3120
  18.       TabIndex        =   20
  19.       Top             =   3300
  20.       Width           =   5865
  21.    End
  22.    Begin VB.CommandButton cmdCreateGroup 
  23.       Caption         =   "Create Group"
  24.       Height          =   375
  25.       Left            =   180
  26.       TabIndex        =   18
  27.       Top             =   1050
  28.       Width           =   1125
  29.    End
  30.    Begin VB.CommandButton cmdGetLinkInfo 
  31.       Caption         =   "GetLinkInfo"
  32.       Height          =   375
  33.       Left            =   180
  34.       TabIndex        =   17
  35.       Top             =   540
  36.       Width           =   1125
  37.    End
  38.    Begin VB.ComboBox cmbSysFolders 
  39.       Height          =   315
  40.       Left            =   3120
  41.       TabIndex        =   16
  42.       Top             =   90
  43.       Width           =   5865
  44.    End
  45.    Begin VB.CommandButton cmdGetPath 
  46.       Caption         =   "GetSysPath"
  47.       Height          =   375
  48.       Left            =   1920
  49.       TabIndex        =   15
  50.       Top             =   60
  51.       Width           =   1125
  52.    End
  53.    Begin VB.TextBox txtShowCmd 
  54.       Height          =   285
  55.       Left            =   3120
  56.       TabIndex        =   13
  57.       Top             =   2895
  58.       Width           =   585
  59.    End
  60.    Begin VB.TextBox txtCmdArgs 
  61.       Height          =   285
  62.       Left            =   3120
  63.       TabIndex        =   11
  64.       Top             =   1740
  65.       Width           =   5865
  66.    End
  67.    Begin VB.TextBox txtIconIndex 
  68.       Height          =   285
  69.       Left            =   3120
  70.       TabIndex        =   9
  71.       Top             =   2505
  72.       Width           =   585
  73.    End
  74.    Begin VB.TextBox txtIconFile 
  75.       Height          =   285
  76.       Left            =   3120
  77.       TabIndex        =   7
  78.       Top             =   2130
  79.       Width           =   5865
  80.    End
  81.    Begin VB.TextBox txtWorkDir 
  82.       Height          =   285
  83.       Left            =   3120
  84.       TabIndex        =   5
  85.       Top             =   1365
  86.       Width           =   5865
  87.    End
  88.    Begin VB.TextBox txtExeName 
  89.       Height          =   285
  90.       Left            =   3120
  91.       TabIndex        =   3
  92.       Top             =   975
  93.       Width           =   5865
  94.    End
  95.    Begin VB.TextBox txtLinkName 
  96.       Height          =   285
  97.       Left            =   3120
  98.       TabIndex        =   1
  99.       Top             =   600
  100.       Width           =   5865
  101.    End
  102.    Begin VB.CommandButton cmdCreateLink 
  103.       Caption         =   "CreateLink"
  104.       Height          =   345
  105.       Left            =   180
  106.       TabIndex        =   0
  107.       Top             =   60
  108.       Width           =   1155
  109.    End
  110.    Begin VB.Label Label1 
  111.       AutoSize        =   -1  'True
  112.       Caption         =   "Start Menu Group:"
  113.       Height          =   195
  114.       Index           =   7
  115.       Left            =   1770
  116.       TabIndex        =   19
  117.       Top             =   3360
  118.       Width           =   1305
  119.    End
  120.    Begin VB.Label Label1 
  121.       AutoSize        =   -1  'True
  122.       Caption         =   "Show Command:"
  123.       Height          =   195
  124.       Index           =   6
  125.       Left            =   1860
  126.       TabIndex        =   14
  127.       Top             =   2940
  128.       Width           =   1200
  129.    End
  130.    Begin VB.Label Label1 
  131.       AutoSize        =   -1  'True
  132.       Caption         =   "Cmd Arguments:"
  133.       Height          =   195
  134.       Index           =   5
  135.       Left            =   1890
  136.       TabIndex        =   12
  137.       Top             =   1800
  138.       Width           =   1155
  139.    End
  140.    Begin VB.Label Label1 
  141.       AutoSize        =   -1  'True
  142.       Caption         =   "Icon Index:"
  143.       Height          =   195
  144.       Index           =   4
  145.       Left            =   2265
  146.       TabIndex        =   10
  147.       Top             =   2565
  148.       Width           =   795
  149.    End
  150.    Begin VB.Label Label1 
  151.       AutoSize        =   -1  'True
  152.       Caption         =   "Icon FileName:"
  153.       Height          =   195
  154.       Index           =   3
  155.       Left            =   1965
  156.       TabIndex        =   8
  157.       Top             =   2175
  158.       Width           =   1065
  159.    End
  160.    Begin VB.Label Label1 
  161.       AutoSize        =   -1  'True
  162.       Caption         =   "Working Directory:"
  163.       Height          =   195
  164.       Index           =   2
  165.       Left            =   1740
  166.       TabIndex        =   6
  167.       Top             =   1425
  168.       Width           =   1320
  169.    End
  170.    Begin VB.Label Label1 
  171.       AutoSize        =   -1  'True
  172.       Caption         =   "Exe Name:"
  173.       Height          =   195
  174.       Index           =   1
  175.       Left            =   2280
  176.       TabIndex        =   4
  177.       Top             =   1035
  178.       Width           =   780
  179.    End
  180.    Begin VB.Label Label1 
  181.       AutoSize        =   -1  'True
  182.       Caption         =   "Link Name:"
  183.       Height          =   195
  184.       Index           =   0
  185.       Left            =   2250
  186.       TabIndex        =   2
  187.       Top             =   660
  188.       Width           =   810
  189.    End
  190. Attribute VB_Name = "frmTestSLnk"
  191. Attribute VB_GlobalNameSpace = False
  192. Attribute VB_Creatable = False
  193. Attribute VB_PredeclaredId = True
  194. Attribute VB_Exposed = False
  195. Option Explicit
  196. '---------------------------------------------------------------
  197. Private Sub cmdCreateGroup_Click()
  198. '---------------------------------------------------------------
  199.     MkDir txtProgramGroup.Text                          ' Create Start Menu Program Group...
  200. '---------------------------------------------------------------
  201. End Sub
  202. '---------------------------------------------------------------
  203. '---------------------------------------------------------------
  204. Private Sub cmdCreateLink_Click()
  205. '---------------------------------------------------------------
  206.     Dim sLnk As cShellLink                              ' ShellLink Variable
  207. '---------------------------------------------------------------
  208.     Set sLnk = New cShellLink                           ' Create ShellLink Instance
  209.     sLnk.CreateShellLink txtLinkName.Text, _
  210.                          txtExeName.Text, _
  211.                          txtWorkDir.Text, _
  212.                          txtCmdArgs.Text, _
  213.                          txtIconFile.Text, _
  214.                     CLng(txtIconIndex.Text), _
  215.                     CLng(txtShowCmd.Text)               ' Create a ShellLink (ShortCut)
  216.     Set sLnk = Nothing                                  ' Destroy object reference
  217. '---------------------------------------------------------------
  218. End Sub
  219. '---------------------------------------------------------------
  220. '---------------------------------------------------------------
  221. Private Sub cmdGetLinkInfo_Click()
  222. '---------------------------------------------------------------
  223.     Dim sLnk As cShellLink                              ' ShellLink class variable
  224.     Dim LnkFile As String                               ' Link file name
  225.     Dim ExeFile As String                               ' Link - Exe file name
  226.     Dim WorkDir As String                               '      - Working directory
  227.     Dim ExeArgs As String                               '      - Command line arguments
  228.     Dim IconFile As String                              '      - Icon File name
  229.     Dim IconIdx As Long                                 '      - Icon Index
  230.     Dim ShowCmd As Long                                 '      - Program start state...
  231. '---------------------------------------------------------------
  232.     Set sLnk = New cShellLink                           ' Create new Explorer IShellLink Instance
  233.     LnkFile = txtLinkName.Text                          ' Get link file name
  234.     txtExeName.Text = ""                                ' Clear output variables...
  235.     txtWorkDir.Text = ""
  236.     txtCmdArgs.Text = ""
  237.     txtIconFile.Text = ""
  238.     txtIconIndex.Text = ""
  239.     txtShowCmd.Text = ""
  240.     sLnk.GetShellLinkInfo LnkFile, _
  241.                           ExeFile, _
  242.                           WorkDir, _
  243.                           ExeArgs, _
  244.                           IconFile, _
  245.                           IconIdx, _
  246.                           ShowCmd                       ' Get Info for shortcut file...
  247.                         
  248.     txtLinkName.Text = LnkFile                          ' Display output...
  249.     txtExeName.Text = ExeFile
  250.     txtWorkDir.Text = WorkDir
  251.     txtCmdArgs.Text = ExeArgs
  252.     txtIconFile.Text = IconFile
  253.     txtIconIndex.Text = Val(IconIdx)
  254.     txtShowCmd.Text = Val(ShowCmd)
  255.     Set sLnk = Nothing                                  ' Destroy object reference...
  256. '---------------------------------------------------------------
  257. End Sub
  258. '---------------------------------------------------------------
  259. '---------------------------------------------------------------
  260. Private Sub cmdGetPath_Click()
  261. '---------------------------------------------------------------
  262.     Dim rc As Long                                      ' return code
  263.     Dim sLnk As cShellLink                              ' ShellLink class object
  264.     Dim sfPath As String                                ' System folder path
  265.     Dim Id As Long                                      ' ID of System folder...
  266. '---------------------------------------------------------------
  267.     ' Create instance of Explorer's IShellLink Interface Base Class
  268.     Set sLnk = New cShellLink
  269.     Id = cmbSysFolders.ItemData(cmbSysFolders.ListIndex)  ' Get ID from combo box
  270.     If sLnk.GetSystemFolderPath(Me.hWnd, Id, sfPath) Then ' Get system folder path from id
  271.         SetDefaults sfPath                                ' Update UI with new path
  272.     End If
  273.     Set sLnk = Nothing                                  ' Destroy object reference
  274. '---------------------------------------------------------------
  275. End Sub
  276. '---------------------------------------------------------------
  277. '---------------------------------------------------------------
  278. Private Sub Form_Load()
  279. '---------------------------------------------------------------
  280.     SetDefaults (App.Path & "\")                    ' Update UI with current application path
  281.     With cmbSysFolders                              ' Add ID's for system folders to combo box...
  282.         .AddItem "DESKTOP"
  283.         .ItemData(.NewIndex) = 0
  284.         .AddItem "PROGRAMS"
  285.         .ItemData(.NewIndex) = &H2
  286.         .AddItem "Controls"
  287.         .ItemData(.NewIndex) = &H3
  288.         .AddItem "Printers"
  289.         .ItemData(.NewIndex) = &H4
  290.         .AddItem "PERSONAL"
  291.         .ItemData(.NewIndex) = &H5
  292.         .AddItem "FAVORITES"
  293.         .ItemData(.NewIndex) = &H6
  294.         .AddItem "STARTUP"
  295.         .ItemData(.NewIndex) = &H7
  296.         .AddItem "RECENT"
  297.         .ItemData(.NewIndex) = &H8
  298.         .AddItem "SENDTO"
  299.         .ItemData(.NewIndex) = &H9
  300.         .AddItem "BITBUCKET: RECYCLE-BIN"
  301.         .ItemData(.NewIndex) = &HA
  302.         .AddItem "STARTMENU"
  303.         .ItemData(.NewIndex) = &HB
  304.         .AddItem "DESKTOPDIRECTORY"
  305.         .ItemData(.NewIndex) = &H10
  306.         .AddItem "DRIVES"
  307.         .ItemData(.NewIndex) = &H11
  308.         .AddItem "NETWORK"
  309.         .ItemData(.NewIndex) = &H12
  310.         .AddItem "NETHOOD"
  311.         .ItemData(.NewIndex) = &H13
  312.         .AddItem "Fonts"
  313.         .ItemData(.NewIndex) = &H14
  314.         .AddItem "TEMPLATES"
  315.         .ItemData(.NewIndex) = &H15
  316.         .AddItem "COMMON_STARTMENU"
  317.         .ItemData(.NewIndex) = &H16
  318.         .AddItem "COMMON_PROGRAMS"
  319.         .ItemData(.NewIndex) = &H17
  320.         .AddItem "COMMON_STARTUP"
  321.         .ItemData(.NewIndex) = &H18
  322.         .AddItem "COMMON_DESKTOPDIRECTORY"
  323.         .ItemData(.NewIndex) = &H19
  324.         .AddItem "APPDATA"
  325.         .ItemData(.NewIndex) = &H1A
  326.         .AddItem "PRINTHOOD"
  327.         .ItemData(.NewIndex) = &H1B
  328.         
  329.         .ListIndex = 0
  330.     End With
  331. '---------------------------------------------------------------
  332. End Sub
  333. '---------------------------------------------------------------
  334. '---------------------------------------------------------------
  335. Private Sub SetDefaults(pth As String)
  336. '---------------------------------------------------------------
  337.     Dim AppPath As String                                   ' Current Application path
  338. '---------------------------------------------------------------
  339.     AppPath = App.Path                                      ' Get current path
  340.     If (Right$(AppPath, 1) <> "\") Then AppPath = AppPath & "\" ' Fix application path if necessary
  341.     If (Right$(pth, 1) <> "\") Then pth = pth & "\"         ' Fix path if necessary
  342.     txtLinkName.Text = pth & "testlink.lnk"                 ' Create a full path name for link file
  343.     txtExeName.Text = AppPath & App.EXEName & ".exe"        ' Create a full path name for applicaton exe name
  344.     txtWorkDir.Text = AppPath                               ' Set default working directory
  345.     txtCmdArgs.Text = "-ARG1 -ARG2"                         ' Set default arguments
  346.     txtIconFile.Text = txtExeName.Text                      ' Set default IconFile name to default exename
  347.     txtIconIndex.Text = CStr(1)                             ' Set default Icon Index val
  348.     txtShowCmd.Text = CStr(7)                               ' set default showcommand val
  349.     txtProgramGroup.Text = pth & "Test Link Program Group"  ' Set default Program group name
  350. '---------------------------------------------------------------
  351. End Sub
  352. '---------------------------------------------------------------
  353.